home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / GEM / GEMSHARE.I < prev    next >
Encoding:
Modula Implementation  |  1994-01-11  |  44.6 KB  |  1,359 lines
  1. IMPLEMENTATION MODULE GEMShare;
  2. (*$L-, N+, Y+*)
  3.  
  4.  
  5. (*      Megamax Modula-2 GEM Library: Von allen GEM-Library-Modulen genutzte
  6.  *                                    Definitionen und Routinen.
  7.  *                                    (INTERNES MODUL)
  8.  *
  9.  *      Autor: Manuel Chakravarty       Erstellt: März-Dezember 1987
  10.  *
  11.  *      MS: Michael Seyfried
  12.  *
  13.  *      Version 2.1     V#0191
  14.  *)
  15.  
  16. (*  28.12.87    | Switching der Prozeßkennung bei Accsessories
  17.  *  02.01.88    | Die Vektorexchangeroutine benutzen nun das 'DeviceHandle'
  18.  *                und nicht die VDI-Gerätekennung
  19.  *  22.01.88 TT | vdi_if lädt handle runter bei opcode = open_v_work
  20.  *  07.02.88    | Process-switching bei 'aes_call' funktioniert nun korrekt
  21.  *  04.05.88    | Vorläufige Version ohne Process-switching (für Dietmar
  22.  *              | Rabich)
  23.  *  02.06.88    | 'removeTimerVec' korrigiert
  24.  *  08.04.89    | process switching ganz raus.
  25.  *  28.06.89    | 'checkErrorTest' hat den Zeiger auf die Prozedurvariable
  26.  *                beim Benutzen nicht dereferenziert.
  27.  *  02.08.89    | No more 'suspendedID', 'startID'
  28.  *  03.08.89    | LINK in 'selectFile'
  29.  *  ???????? TT | REF-Parm.
  30.  *  02.04.90    | Aufteilung in public und private Datenstrukturen
  31.  *  13.06.90 TT | echantSuperMode gelöscht
  32.  *  05.10.90    | 'shellRead' def. + impl.
  33.  *  25.11.90 TT | Um Rekursion in GEMError zu verhindern, wird "error" schon
  34.  *                VOR Aufruf des Error-Handlers gelöscht; 'errNum' wird in
  35.  *                setINT0attribut & gemErrorOccured auf Null gesetzt, damit
  36.  *                zumindest ein definierter Wert darin enthalten ist.
  37.  *                'ptrToErrHdler' neu - wird bei Auftreten eines Fehlers
  38.  *                indirekt über die GemEnv-Var. "ErrHdlProc" aufgerufen.
  39.  *                Überhaupt: 'testINTOUT0' signalisiert nur einen Fehler,
  40.  *                wenn 'errnum' Null ist. Wozu dann überhaupt eine Var dafür?
  41.  *  04.12.90 TT | stringIntoCFormat: SUB D1,D0 nun als Long-Operation!
  42.  *  25.02.91 TT | unloadFonts aus VDIControls übertragen
  43.  *  20.05.91 MS | unloadFonts korrigiert
  44.  *  21.08.91 TT | 'signalGemError' macht RTS statt Runtime-Error, wenn
  45.  *                'ptrToErrHdler' = NIL ist.
  46.  *  22.05.93 TT | 'signalGemError': LINK A5,#0
  47.  *)
  48.  
  49.  
  50. FROM SYSTEM     IMPORT ASSEMBLER, BYTE, WORD, ADR;
  51.  
  52. FROM MOSGlobals IMPORT OutOfStack, IllegalPointer, StringOverflow;
  53.  
  54. FROM GrafBase   IMPORT Point, Rectangle, PtrMouseFormDef;
  55.  
  56. (*$I GEMOPS.ICL *)
  57. (*$I GEMCNF.ICL *)
  58.  
  59.  
  60. FORWARD testErrorCheck;
  61. FORWARD gemErrorOccured;
  62.  
  63.  
  64.                 (*  Misc. subroutines  *)
  65.                 (*  =================  *)
  66.  
  67. PROCEDURE getCalcedFrame(frame:Rectangle);
  68.  
  69.   BEGIN
  70.     ASSEMBLER
  71.         MOVE.L      -(A3),D0
  72.         MOVE.L      -(A3),D1
  73.         ADD.L       D1,D0
  74.         SUBQ.W      #1,D0
  75.         SUB.L       #$10000,D0
  76.         MOVE.L      D0,-(A1)        ; x+w-1 -> ptsin(x+2), y+h-1 -> ptsin(x+3)
  77.         MOVE.L      D1,-(A1)        ; x -> ptsin(x) , y -> ptsin(x+1)
  78.     END;
  79.   END getCalcedFrame;
  80.  
  81. PROCEDURE stringIntoINTIN(REF str:ARRAY OF CHAR):CARDINAL;
  82.  
  83.   BEGIN
  84.     ASSEMBLER
  85.         MOVE.W  #intinMax,D1
  86.         SUB.W   D4,D1                   ; Anzahl benutzbarer Elem. -> D1
  87.         MOVE.L  pubs,A0
  88.         LEA     pubArrays.vINTIN(A0),A0  ; ADR(INTIN[0]) -> A0
  89.         LSL.W   #1,D4                   ; 1 Element verbraucht 2 Byte
  90.         ADDA.W  D4,A0                   ; Offset hinzuzählen
  91.         MOVE.W  -(A3),D0
  92.         MOVE.L  -(A3),A1                ; ADR(str) -> A1
  93.         CMP.W   D1,D0                   ; Wenn String zu lang, benutze nur
  94.         BLS     cont                    ; den Teil, der noch ins Array paßt
  95.         MOVE.W  D1,D0
  96. cont
  97.         MOVE.W  D0,D2                   ; Store num. of max. chars to copy
  98.         CLR.W   D1
  99. loop                                    ; Kopiere bis 0C oder max. Arrayindex
  100.         MOVE.B  (A1)+,D1
  101.         MOVE.W  D1,(A0)+
  102.         DBEQ    D0,loop
  103.         SUB.W   D0,D2                   ; Anzahl kopierter Zeichen ermitteln
  104.         MOVE.W  D2,(A3)+                ; und zurückgeben
  105.     END;
  106.   END stringIntoINTIN;
  107.  
  108. (*
  109. PROCEDURE enchantSuperMode;
  110.  
  111.   BEGIN
  112.     ASSEMBLER
  113.         JMP     EnterSupervisorMode
  114.     END;
  115.   END enchantSuperMode;
  116.  *)
  117.  
  118. PROCEDURE stringIntoCFormat (REF str: ARRAY OF CHAR);
  119.  
  120.   BEGIN
  121.     ASSEMBLER
  122.         MOVE.L  (A7)+,A2        ; Rette Rückkehraddr.
  123.         MOVEQ   #0,D1
  124.         MOVE.W  -(A3),D1        ; HIGH(str) -> D1
  125.         MOVE.L  A7,D0           ; Berechne neuen Top of Stack
  126.         SUB.L   D1,D0
  127.         SUBQ.L  #2,D0
  128.         BCLR    #0,D0           ; nur gerade Stackaddr. erlaubt
  129.  
  130.         CMP.L   A3,D0
  131.         BCC     cont2           ; springe, falls kein Stack Overflow
  132.         TRAP    #noErrorTrap
  133.         DC.W    OutOfStack
  134. cont2
  135.         MOVE.L  D0,A0           ; rette Zeiger auf Stringanfang
  136.         EXG     D0,A7
  137.         MOVE.L  D0,-(A7)        ; orginal Stackaddr. merken
  138.         MOVE.L  -(A3),A1        ; ADR(str) -> A1
  139.         MOVE.L  A0,D2           ; rette Zeiger auf Stringanfang
  140. loop
  141.         MOVE.B  (A1)+,(A0)+
  142.         DBEQ    D1,loop         ; kopiere bis zum Stringende
  143.         CLR.B   (A0)+           ; und hänge #0 als Endezeichen an
  144.         MOVE.L  A2,-(A7)        ; Rückkehraddr. für RTS auf den Stack
  145.     END;
  146.   END stringIntoCFormat;
  147.  
  148.  
  149. PROCEDURE setDevice(handle:p_device;VAR success:BOOLEAN);
  150.  
  151.   VAR     current                 :p_device;
  152.  
  153.   BEGIN
  154.     ASSEMBLER
  155.         JSR     testErrorCheck;
  156.         MOVE.L  -(A3),A2
  157.         MOVE.L  -(A3),D0
  158.         AND.W   #-2,D0                  ; Addr. muß gerade sein
  159.         MOVE.L  D0,A0
  160.         CMPA.L  #NIL,A0
  161.         BNE     cont
  162.         JSR     gemErrorOccured
  163.         MOVE.W  #FALSE,(A2)
  164.         BRA     ende
  165. cont
  166.         MOVE.W  device.magic(A0),D0
  167.         CMP.W   #deviceMagic,D0
  168.         BEQ     cont2
  169.         TRAP    #noErrorTrap
  170.         DC.W    IllegalPointer
  171.         MOVE.W  #FALSE,(A2)
  172.         BRA     ende
  173. cont2
  174.         MOVE.L  our_cb,A1
  175.         MOVE.L  A0,cb.CURDEVICE(A1)
  176.         MOVE.W  #TRUE,(A2)
  177. ende
  178.     END;
  179.   END setDevice;
  180.  
  181.                         (*  global error handling  *)
  182.                         (*  =====================  *)
  183.  
  184. PROCEDURE signalGemError;
  185. (*
  186.  * Hier wird "error" auf TRUE gesetzt, so daß der User den Fehler
  187.  * dann abfragen kann.
  188.  * Falls aber mittels des Util-Moduls "GemErrLocator" der unmittelbare
  189.  * Error-Handler installiert ist, wird sofort darüber der Fehler
  190.  * angezeigt, so daß ein Scanning auf den Verursacher möglich ist.
  191.  *)
  192.   BEGIN
  193.     ASSEMBLER
  194.         MOVE.W  #TRUE,error
  195.         
  196.         MOVE.L  ptrToErrHdler,D0
  197.         BEQ     ende
  198.         
  199.         LINK    A5,#0
  200.         MOVE.L  D0,A0
  201.         MOVE.L  (A0),A0
  202.         JSR     (A0)
  203.         UNLK    A5
  204. ende
  205.     END;
  206.   END signalGemError;
  207.  
  208. PROCEDURE testINTOUT0;
  209. (*
  210.  * Aufzurufen nach einem AES-Call. INTOUT[0] wird geprüft. Wenn Fehler
  211.  * angezeigt, wird 'error'-Flag gesetzt.
  212.  *)
  213.   BEGIN
  214.     ASSEMBLER
  215.         MOVE.L  pubs,A0
  216.         CLR.W   D0
  217.         MOVE.W  pubArrays.aINTOUT(A0),errNum
  218.         BNE     noError
  219.         JMP     signalGemError
  220.       noError
  221.     END;
  222.   END testINTOUT0;
  223.  
  224. PROCEDURE testErrorCheck;
  225. (*
  226.  * Aufzurufen zu Beginn einer GEM-Routine. Falls 'error'-Flag gesetzt,
  227.  * wird GEM-Fehler gemeldet.
  228.  *)
  229.   BEGIN
  230.     ASSEMBLER
  231.         TST.W   error
  232.         BEQ     ende            ; no error => branch
  233.         
  234.         CLR.W   error           ; verhindert Rekursion
  235.         
  236.         MOVE.L  errorProcPtr,D0
  237.         BEQ     noProcInstalled
  238.         
  239.         MOVE.L  D0,A0
  240.         MOVE.L  (A0),A0
  241.         JSR     (A0)
  242.         BRA     ende
  243.         
  244. noProcInstalled
  245.         TRAP    #noErrorTrap
  246.         DC.W    IllegalPointer - $4000
  247. ende
  248.     END;
  249.   END testErrorCheck;
  250.  
  251. PROCEDURE gemErrorOccured;
  252. (*
  253.  * Aufzurufen, wenn Fehler auftrat. 'error'-Flag wird gesetzt.
  254.  *)
  255.   BEGIN
  256.     ASSEMBLER
  257.         CLR.W   errNum
  258.         JMP     signalGemError
  259.     END;
  260.   END gemErrorOccured;
  261.  
  262.  
  263.                                 (*  A E S  *)
  264.                                 (*  =====  *)
  265.  
  266. PROCEDURE aes_call (pb: p_cb);
  267.  
  268.   BEGIN
  269.     ASSEMBLER
  270.         MOVE.L  -(A3),A0
  271.         LEA     cb.AESPB(A0),A0
  272.         MOVE.L  A0,D1
  273.         MOVE.W  #AESCode,D0
  274.         TRAP    #GEMTrap
  275.     END
  276.   END aes_call;
  277.  
  278. PROCEDURE ctrl_cnts;
  279.  
  280.   BEGIN
  281.     ASSEMBLER
  282.     ;                             Dummies
  283.         DC.B    0, 0, 0            ; func 000
  284.         DC.B    0, 0, 0            ; func 001
  285.         DC.B    0, 0, 0            ; func 002
  286.         DC.B    0, 0, 0            ; func 003
  287.         DC.B    0, 0, 0            ; func 004
  288.         DC.B    0, 0, 0            ; func 005
  289.         DC.B    0, 0, 0            ; func 006
  290.         DC.B    0, 0, 0            ; func 007
  291.         DC.B    0, 0, 0            ; func 008
  292.         DC.B    0, 0, 0            ; func 009
  293.     ;                             Application Manager
  294.         DC.B    0, 1, 0            ; func 010  init
  295.         DC.B    2, 1, 1            ; func 011  read
  296.         DC.B    2, 1, 1            ; func 012  write
  297.         DC.B    0, 1, 1            ; func 013  find
  298.         DC.B    2, 1, 1            ; func 014  tplay
  299.         DC.B    1, 1, 1            ; func 015  trec
  300.         DC.B    0, 0, 0            ; func 016
  301.         DC.B    0, 0, 0            ; func 017
  302.         DC.B    0, 0, 0            ; func 008
  303.         DC.B    0, 1, 0            ; func 019  exit
  304.     ;                             Event Manager
  305.         DC.B    0, 1, 0            ; func 020  evnt keybd
  306.         DC.B    3, 5, 0            ; func 021  evnt but
  307.         DC.B    5, 5, 0            ; func 022  e mouse
  308.         DC.B    0, 1, 1            ; func 023  e msg
  309.         DC.B    2, 1, 0            ; func 024  e timer
  310.         DC.B    16, 7, 1           ; func 025  e multi
  311.         DC.B    2, 1, 0            ; func 026
  312.         DC.B    0, 0, 0            ; func 027
  313.         DC.B    0, 0, 0            ; func 028
  314.         DC.B    0, 0, 0            ; func 009
  315.     ;                             Menu Manager
  316.         DC.B    1, 1, 1            ; func 030  bar
  317.         DC.B    2, 1, 1            ; func 031  icheck
  318.         DC.B    2, 1, 1            ; func 032  ienable
  319.         DC.B    2, 1, 1            ; func 033  tnormal
  320.         DC.B    1, 1, 2            ; func 034  text
  321.         DC.B    1, 1, 1            ; func 005  register
  322.         DC.B    0, 0, 0            ; func 006
  323.         DC.B    0, 0, 0            ; func 007
  324.         DC.B    0, 0, 0            ; func 008
  325.         DC.B    0, 0, 0            ; func 009
  326.     ;                             Object Manager
  327.         DC.B    2, 1, 1            ; func 040  add
  328.         DC.B    1, 1, 1            ; func 041  del
  329.         DC.B    6, 1, 1            ; func 042  draw
  330.         DC.B    4, 1, 1            ; func 043  find
  331.         DC.B    1, 3, 1            ; func 044  offset
  332.         DC.B    2, 1, 1            ; func 045  order
  333.         DC.B    4, 2, 1            ; func 046  edit
  334.         DC.B    8, 1, 1            ; func 047  change
  335.         DC.B    0, 0, 0            ; func 048
  336.         DC.B    0, 0, 0            ; func 049
  337.     ;                             Form Manager
  338.         DC.B    1, 1, 1            ; func 050  do
  339.         DC.B    9, 1, 1            ; func 051  dial
  340.         DC.B    1, 1, 1            ; func 002  alert
  341.         DC.B    1, 1, 0            ; func 003  error
  342.         DC.B    0, 5, 1            ; func 004  center
  343.         DC.B    3, 3, 1            ; func 005  keyboard
  344.         DC.B    2, 2, 1            ; func 006  button
  345.         DC.B    0, 0, 0            ; func 007
  346.         DC.B    0, 0, 0            ; func 008
  347.         DC.B    0, 0, 0            ; func 009
  348.     ;                             Dialog Manager
  349.         DC.B    0, 0, 0            ; func 060
  350.         DC.B    0, 0, 0            ; func 061
  351.         DC.B    0, 0, 0            ; func 062
  352.         DC.B    0, 0, 0            ; func 003
  353.         DC.B    0, 0, 0            ; func 004
  354.         DC.B    0, 0, 0            ; func 005
  355.         DC.B    0, 0, 0            ; func 006
  356.         DC.B    0, 0, 0            ; func 007
  357.         DC.B    0, 0, 0            ; func 008
  358.         DC.B    0, 0, 0            ; func 009
  359.     ;                            Graphics Manager
  360.         DC.B    4, 3, 0            ; func 070  rubber
  361.         DC.B    8, 3, 0            ; func 071  drag
  362.         DC.B    6, 1, 0            ; func 072  move
  363.         DC.B    8, 1, 0            ; func 073  grow
  364.         DC.B    8, 1, 0            ; func 074  shrink
  365.         DC.B    4, 1, 1            ; func 075  watch
  366.         DC.B    3, 1, 1            ; func 076  slide
  367.         DC.B    0, 5, 0            ; func 077  handle
  368.         DC.B    1, 1, 1            ; func 078  mouse
  369.         DC.B    0, 5, 0            ; func 009  mkstate
  370.     ;                            Scrap Manager
  371.         DC.B    0, 1, 1            ; func 080  read
  372.         DC.B    0, 1, 1            ; func 081  write
  373.         DC.B    0, 0, 0            ; func 082
  374.         DC.B    0, 0, 0            ; func 083
  375.         DC.B    0, 0, 0            ; func 084
  376.         DC.B    0, 0, 0            ; func 005
  377.         DC.B    0, 0, 0            ; func 006
  378.         DC.B    0, 0, 0            ; func 007
  379.         DC.B    0, 0, 0            ; func 008
  380.         DC.B    0, 0, 0            ; func 009
  381.     ;                            fseler Manager
  382.         DC.B    0, 2, 2            ; func 090  input
  383.         DC.B    0, 2, 3            ; func 091           (*  Ab TOS 1.4  *)
  384.         DC.B    0, 0, 0            ; func 092
  385.         DC.B    0, 0, 0            ; func 003
  386.         DC.B    0, 0, 0            ; func 004
  387.         DC.B    0, 0, 0            ; func 005
  388.         DC.B    0, 0, 0            ; func 006
  389.         DC.B    0, 0, 0            ; func 007
  390.         DC.B    0, 0, 0            ; func 008
  391.         DC.B    0, 0, 0            ; func 009
  392.     ;                            Window Manager
  393.         DC.B    5, 1, 0            ; func 100
  394.         DC.B    5, 1, 0            ; func 101
  395.         DC.B    1, 1, 0            ; func 102
  396.         DC.B    1, 1, 0            ; func 103
  397.         DC.B    2, 5, 0            ; func 104
  398.         DC.B    6, 1, 0            ; func 105
  399.         DC.B    2, 1, 0            ; func 106
  400.         DC.B    1, 1, 0            ; func 107
  401.         DC.B    6, 5, 0            ; func 108
  402.         DC.B    0, 0, 0            ; func 109           (*  Ab TOS 1.4  *)
  403.     ;                            Resource Manger
  404.         DC.B    0, 1, 1            ; func 110  load
  405.         DC.B    0, 1, 0            ; func 111  free
  406.         DC.B    2, 1, 0            ; func 112  gaddr
  407.         DC.B    2, 1, 1            ; func 113  saddr
  408.         DC.B    1, 1, 1            ; func 114  obfix
  409.         DC.B    0, 0, 0            ; func 115
  410.         DC.B    0, 0, 0            ; func 006
  411.         DC.B    0, 0, 0            ; func 007
  412.         DC.B    0, 0, 0            ; func 008
  413.         DC.B    0, 0, 0            ; func 009
  414.     ;                            Shell Manager
  415.         DC.B    0, 1, 2            ; func 120  read
  416.         DC.B    3, 1, 2            ; func 121  write
  417.         DC.B    1, 1, 1            ; func 122  get
  418.         DC.B    1, 1, 1            ; func 123  put
  419.         DC.B    0, 1, 1            ; func 124  find
  420.         DC.B    0, 1, 2            ; func 125  envrn
  421.     END
  422.   END ctrl_cnts;
  423.  
  424. PROCEDURE aes_if (Opcode: CARDINAL);
  425.  
  426.   BEGIN
  427.     ASSEMBLER
  428.         JSR         testErrorCheck
  429.         MOVE.L      pubs,A0
  430.         CLR.W       pubArrays.aINTOUT(A0)
  431.         MOVE.L      our_cb,A0
  432.         LEA         cb.A_CONTRL(A0),A0
  433.         MOVE.W      -(A3),D0
  434.         MOVE.W      D0,(A0)+
  435.         LEA         ctrl_cnts,A1
  436.         ADDA.W      D0,A1
  437.         ADD.W       D0,D0
  438.         ADDA.W      D0,A1
  439.         CLR.W       D0
  440.         MOVE.B      (A1)+,D0
  441.         MOVE.W      D0,(A0)+
  442.         MOVE.B      (A1)+,D0
  443.         MOVE.W      D0,(A0)+
  444.         MOVE.B      (A1)+,D0
  445.         MOVE.W      D0,(A0)+
  446.         MOVE.L      our_cb,(A3)+
  447.         JSR         aes_call
  448.     END;
  449.   END aes_if;
  450.  
  451.  
  452.                                 (*  V D I  *)
  453.                                 (*  =====  *)
  454.  
  455. PROCEDURE vdi_call (para: p_cb);
  456.  
  457.   BEGIN
  458.     ASSEMBLER
  459.       MOVE.L  -(A3),A0
  460.       LEA     cb.VDIPB(A0),A0
  461.       MOVE.L  A0,D1
  462.       MOVE.L  #VDICode,D0
  463.       TRAP    #GEMTrap
  464.     END
  465.   END vdi_call;
  466.  
  467. PROCEDURE ctrl_cnts2;
  468.                        (* Only sptsin, sintin; no sintout, sptsout *)
  469.   BEGIN
  470.     ASSEMBLER
  471.     ;       PTSIN, INTIN
  472.         DC.B    0, 0         ; func 000
  473.         DC.B    0, 0         ; func 001
  474.         DC.B    0, 0         ; func 002
  475.         DC.B    0, 0         ; func 003 clear workstation
  476.         DC.B    0, 0         ; func 004 update works.
  477.         DC.B    0, 0         ; func 005 escape funktions
  478.         DC.B    0, 0         ; func 006 polyline(ruft vdi_call direkt auf)
  479.         DC.B    0, 0         ; func 007 polymarker(ruft vdi_call direkt auf)
  480.         DC.B    0, 0         ; func 008 graftext(ruft vdi_call direkt auf)
  481.         DC.B    0, 0         ; func 009 filled polygon(ruft vdi_call direkt)
  482.     ;
  483.         DC.B    0, 0         ; func 010  cell array(ruft vdi_call direkt auf)
  484.         DC.B    0, 0         ; func 011   (* Graf.Grundfkten *)
  485.         DC.B    1, 0         ; func 012  text height abs.
  486.         DC.B    0, 1         ; func 013  baseline
  487.         DC.B    0, 4         ; func 014  color rep
  488.         DC.B    0, 1         ; func 015  line type
  489.         DC.B    1, 0         ; func 016  line width
  490.         DC.B    0, 1         ; func 017  line color
  491.         DC.B    0, 1         ; func 008  marker type
  492.         DC.B    1, 0         ; func 019  marker height
  493.     ;
  494.         DC.B    0, 1         ; func 020  marker color
  495.         DC.B    0, 1         ; func 021  text face
  496.         DC.B    0, 1         ; func 022  text color
  497.         DC.B    0, 1         ; func 023  fill interior
  498.         DC.B    0, 1         ; func 024  fill index
  499.         DC.B    0, 1         ; func 025  fill color
  500.         DC.B    0, 2         ; func 026  inq. color
  501.         DC.B    2, 0         ; func 027  inq. cell array
  502.         DC.B    1, 0         ; func 028  inp loc
  503.         DC.B    0, 1         ; func 009  inp val
  504.     ;
  505.         DC.B    0, 0         ; func 030  inp choice ( vdi_call direkt )
  506.         DC.B    1, 2         ; func 031  inp str
  507.         DC.B    0, 1         ; func 032  writing mode
  508.         DC.B    0, 2         ; func 033  set_input_mode
  509.         DC.B    2, 0         ; func 034
  510.         DC.B    0, 0         ; func 005  inq. line
  511.         DC.B    0, 0         ; func 006  inq. mark
  512.         DC.B    0, 0         ; func 007  inq. fill
  513.         DC.B    0, 0         ; func 008  inq. text
  514.         DC.B    0, 2         ; func 009  text alig
  515.     ;
  516.         DC.B    1, 0         ; func 040
  517.         DC.B    1, 0         ; func 041
  518.         DC.B    1, 0         ; func 042
  519.         DC.B    1, 0         ; func 043
  520.         DC.B    1, 0         ; func 044
  521.         DC.B    1, 0         ; func 045
  522.         DC.B    1, 0         ; func 046
  523.         DC.B    1, 0         ; func 047
  524.         DC.B    0, 0         ; func 048
  525.         DC.B    0, 0         ; func 049
  526.     ;
  527.         DC.B    1, 0         ; func 050
  528.         DC.B    1, 0         ; func 051
  529.         DC.B    1, 0         ; func 002
  530.         DC.B    0, 0         ; func 003
  531.         DC.B    1, 0         ; func 004
  532.         DC.B    1, 0         ; func 005
  533.         DC.B    1, 0         ; func 006
  534.         DC.B    0, 0         ; func 007
  535.         DC.B    0, 0         ; func 008
  536.         DC.B    0, 0         ; func 009
  537.     ;
  538.         DC.B    0, 0         ; func 060
  539.         DC.B    0, 0         ; func 061
  540.         DC.B    0, 0         ; func 062
  541.         DC.B    0, 0         ; func 003
  542.         DC.B    1, 0         ; func 004
  543.         DC.B    1, 0         ; func 005
  544.         DC.B    1, 0         ; func 006
  545.         DC.B    0, 0         ; func 007
  546.         DC.B    0, 0         ; func 008
  547.         DC.B    0, 0         ; func 009
  548.     ;
  549.         DC.B    0, 0         ; func 070
  550.         DC.B    0, 0         ; func 071
  551.         DC.B    0, 0         ; func 072
  552.         DC.B    0, 0         ; func 073
  553.         DC.B    0, 0         ; func 074
  554.         DC.B    1, 0         ; func 075
  555.         DC.B    1, 0         ; func 076
  556.         DC.B    0, 0         ; func 077
  557.         DC.B    1, 0         ; func 078
  558.         DC.B    0, 0         ; func 009
  559.     ;
  560.         DC.B    1, 0         ; func 080
  561.         DC.B    1, 0         ; func 081
  562.         DC.B    0, 0         ; func 082
  563.         DC.B    0, 0         ; func 083
  564.         DC.B    0, 0         ; func 084
  565.         DC.B    1, 0         ; func 005
  566.         DC.B    1, 0         ; func 006
  567.         DC.B    0, 0         ; func 007
  568.         DC.B    0, 0         ; func 008
  569.         DC.B    0, 0         ; func 009
  570.     ;
  571.         DC.B    2, 0         ; func 090
  572.         DC.B    0, 0         ; func 091
  573.         DC.B    0, 0         ; func 092
  574.         DC.B    0, 0         ; func 003
  575.         DC.B    0, 0         ; func 004
  576.         DC.B    1, 0         ; func 005
  577.         DC.B    1, 0         ; func 006
  578.         DC.B    0, 0         ; func 007
  579.         DC.B    0, 0         ; func 008
  580.         DC.B    0, 0         ; func 009
  581.     ;
  582.         DC.B    0, 11        ; func 100  open work
  583.         DC.B    0, 0         ; func 101  close work
  584.         DC.B    0, 1         ; func 102  ext. inquire
  585.         DC.B    1, 1         ; func 103  contour fill
  586.         DC.B    0, 1         ; func 104  fill perim.
  587.         DC.B    1, 0         ; func 105  get pixel
  588.         DC.B    0, 1         ; func 106  text effect
  589.         DC.B    0, 1         ; func 107  text height pts
  590.         DC.B    0, 2         ; func 108  line end
  591.         DC.B    4, 1         ; func 009  copy opaque
  592.     ;
  593.         DC.B    0, 0         ; func 110  transform form
  594.         DC.B    0, 37        ; func 111  mouse form
  595.         DC.B    0, 0         ; func 112  user fill( ruft vdi_call direkt )
  596.         DC.B    0, 1         ; func 113  user line
  597.         DC.B    2, 0         ; func 114  fill rect
  598.         DC.B    0, 1         ; func 115  inq. input
  599.         DC.B    0, 0         ; func 006  text ext.( ruft vdi_call direkt )
  600.         DC.B    0, 1         ; func 007  inq. cell
  601.         DC.B    0, 0         ; func 008  time inter
  602.         DC.B    0, 1         ; func 009  load fonts
  603.     ;
  604.         DC.B    0, 1         ; func 120  unload fonts
  605.         DC.B    4, 3         ; func 121  copy transp.
  606.         DC.B    0, 1         ; func 122  show cursor
  607.         DC.B    0, 0         ; func 123  hide cur.
  608.         DC.B    0, 0         ; func 124  mouse buts
  609.         DC.B    0, 0         ; func 125  but change
  610.         DC.B    0, 0         ; func 126  mouse move
  611.         DC.B    0, 0         ; func 127  mouse change
  612.         DC.B    0, 0         ; func 128  key state
  613.         DC.B    2, 1         ; func 129  clipping
  614.      ;
  615.         DC.B    0, 1         ; func 130  face name
  616.         DC.B    0, 0         ; func 131  face info
  617.     END
  618.   END ctrl_cnts2;
  619.   
  620.   (* Control Array Parameter für die Generalized Drawing Primitives (GDP) *)
  621.   
  622. PROCEDURE ctrl_cnts3;
  623.  
  624.   BEGIN
  625.     ASSEMBLER
  626.         DC.B        0, 0      ; *DUMMY*
  627.         DC.B        2, 0      ; #1  Bar
  628.         DC.B        4, 2      ; #2  Arc
  629.         DC.B        4, 2      ; #3  Pie
  630.         DC.B        3, 0      ; #4  Circle
  631.         DC.B        2, 0      ; #5  Ellipse
  632.         DC.B        2, 2      ; #6  ElliptArc
  633.         DC.B        2, 2      ; #7  ElliptPie
  634.         DC.B        2, 0      ; #8  RoundRect
  635.         DC.B        2, 0      ; #9  FillRoundRect
  636.         DC.B        0, 0      ; #10 JustText ( ruft vdi_call direkt auf )
  637.     END;
  638.   END ctrl_cnts3;
  639.  
  640.     (* Control Array Parameter für die VDI-Escape-Funktionen *)
  641.   
  642. PROCEDURE ctrl_cnts4;
  643.  
  644.   BEGIN
  645.     ASSEMBLER
  646.         DC.B    0, 0    ; *DUMMY*
  647.         DC.B    0, 0    ; #1  GetCharCells
  648.         DC.B    0, 0    ; #2  ExitCur
  649.         DC.B    0, 0    ; #3  EnterCur
  650.         DC.B    0, 0    ; #4  CurUp
  651.         DC.B    0, 0    ; #5  CurDown
  652.         DC.B    0, 0    ; #6  CurRight
  653.         DC.B    0, 0    ; #7  CurLeft
  654.         DC.B    0, 0    ; #8  CurHome
  655.         DC.B    0, 0    ; #9  EEOS
  656.         DC.B    0, 0    ; #10 EEOL
  657.         DC.B    0, 2    ; #11 SetCurAdr
  658.         DC.B    0, 0    ; #12 CurText  (* ruft vdi_call direkt *)
  659.         DC.B    0, 0    ; #13 RVOn
  660.         DC.B    0, 0    ; #14 RVOff
  661.         DC.B    0, 0    ; #15 GetCurAdr
  662.         DC.B    0, 0    ; #16 TabStatus
  663.         DC.B    0, 0    ; #17 Hardcopy
  664.         DC.B    1, 0    ; #18 DspCur
  665.         DC.B    0, 0    ; #19 RmCur
  666.         DC.B    0, 0    ; #20 FormAdv
  667.         DC.B    2, 0    ; #21 OutWind
  668.         DC.B    0, 0    ; #22 ClrDispList
  669.         DC.B    0, 0    ; #23 BitImg (direkt)
  670.         
  671.       ; DC.B    0, 1    ; #60 SelPalette (direkt)
  672.         
  673.     END;
  674.   END ctrl_cnts4;
  675.  
  676. CONST   start_cnts5   = 91;     (*  Erste Subcmd-Nummer in 'ctrl_cnts5'  *)
  677.  
  678. PROCEDURE ctrl_cnts5;
  679.  
  680.   BEGIN
  681.     ASSEMBLER
  682.         DC.B    0, 0    ; #91 vqp_films
  683.         DC.B    0, 0    ; #92 vqp_state
  684.         DC.B    0, 21   ; #93 vsp_state
  685.         DC.B    0, 0    ; #94 vsp_save
  686.         DC.B    0, 0    ; #95 vsp_message
  687.         DC.B    0, 0    ; #96 vsp_error
  688.         DC.B    0, 0    ; #97
  689.         DC.B    2, 0    ; #98 v_meta_extents
  690.         DC.B    0, 0    ; #99 v_write_meta (direkt)
  691.         DC.B    0, 0    ; #100vm_filename (direkt)
  692.         DC.B    0, 1    ; #101v_offset
  693.         DC.B    0, 2    ; #102v_fontinit
  694.     END;
  695.   END ctrl_cnts5;
  696.  
  697. PROCEDURE vdi_if (handle:p_device;Opcode,Subcmd:CARDINAL);
  698.  
  699.   BEGIN
  700.     ASSEMBLER
  701.         JSR         testErrorCheck;
  702.         MOVE.L      our_cb,A0
  703.         MOVE.L      -(A3),D0
  704.         MOVE.W      D0,cb.V_CONTRL.subcmd(A0)       ; subcmd in ctrl-array
  705.         SWAP        D0
  706.         MOVE.W      D0,cb.V_CONTRL.opcode(A0)       ; Opcode in ctrl-array
  707.         CMP.W       #V_OPNWK,D0
  708.         BEQ         cont                            ; springe, falls OpenWorksta.
  709.         CMP.W       #OPEN_V_WORK,D0
  710.         BEQ         cont                            ; oder OpenVirt.Work.
  711.         
  712.         MOVE.L      D0,-(A7)
  713.         SUBQ.L      #2,A7                           ; reserv. 1 Wort auf dem Stack
  714.         MOVE.L      A7,(A3)+                        ; und übergib es als VAR-Parm.
  715.         JSR         setDevice
  716.         MOVE.W      (A7)+,D1
  717.         MOVE.L      (A7)+,D0
  718.         TST.W       D1
  719.         BEQ         ende                            ; falsches 'handle' => RETURN
  720.         
  721.         MOVE.L      our_cb,A0
  722.         MOVE.L      cb.CURDEVICE(A0),A1             ; VDI device handle setzen
  723.         MOVE.W      device.handle(A1),cb.V_CONTRL.handle(A0)
  724.         CMP.W       #GRAF_STANDARD,D0               ; Sonderbehandlung für GRAF_S.
  725.         BEQ         gsCmd
  726.         CMP.W       #ESCAPE,D0                      ; Sonderbehandlung für ESCAPE
  727.         BEQ         escCmd
  728.         LEA         ctrl_cnts2,A1   ; kein graf_standard Befehl
  729.         BRA         cont2
  730. cont
  731.         SUBQ.L      #4,A3           ; !TT 22.01.88
  732.         LEA         ctrl_cnts2,A1   ; kein graf_standard Befehl
  733.         BRA         cont2
  734. gsCmd                               ; GENERALIZED DRAWING PRIMITIVE Befehl
  735.         SWAP        D0              ; Tabellenzeiger ist 'SubCmd'
  736.         LEA         ctrl_cnts3,A1   ; Tabelle ist 'ctrl_cnts3'
  737.         BRA         cont2
  738. escCmd                              ; ESCAPE Befehl
  739.         SWAP        D0
  740.         CMP.W       #start_cnts5,D0
  741.         BCC         escCnts5
  742.         LEA         ctrl_cnts4,A1
  743.         BRA         cont2
  744. escCnts5                            ; erweiterter ESCAPE Befehl
  745.         SUB.W       #start_cnts5,D0
  746.         LEA         ctrl_cnts5,A1
  747. cont2
  748.         ADD.W       D0,D0           ; Tabellenbreite 2 Byte
  749.         ADDA.W      D0,A1           ; ctrl_cnts?+???cmd*2 -> A1
  750.         CLR.W       D0              ; Anzahl Eingabeparam. -> ctrl-array
  751.         MOVE.B      (A1)+,D0
  752.         MOVE.W      D0,cb.V_CONTRL.sptsin(A0)
  753.         MOVE.B      (A1),D0
  754.         MOVE.W      D0,cb.V_CONTRL.sintin(A0)
  755.         MOVE.L      A0,(A3)+
  756.         JSR         vdi_call
  757. ende
  758.     END;
  759.   END vdi_if;
  760.  
  761.  
  762. PROCEDURE setINT0attribut(handle:p_device);
  763.  
  764.   BEGIN
  765.     ASSEMBLER
  766.         MOVE.L      pubs,A0
  767.         MOVE.W      D0,pubArrays.vINTIN(A0)
  768.         MOVE.W      D0,-(A7)
  769.         MOVE.W      D1,(A3)+
  770.         CLR.W       (A3)+
  771.         JSR         vdi_if
  772.         MOVE.W      (A7)+,D0
  773.         MOVE.L      pubs,A0
  774.         CMP.W       pubArrays.vINTOUT(A0),D0
  775.         BEQ         cont            ; error:=(INTOUT[0]#Attributwert)
  776.         CLR.W       errNum
  777.         JMP         signalGemError
  778. cont
  779.     END;
  780.   END setINT0attribut;
  781.  
  782.  
  783. PROCEDURE selectFile0 (VAR path, name: ARRAY OF CHAR;
  784.                        VAR ok        : BOOLEAN;
  785.                            opcode    : CARDINAL);
  786.  
  787.   BEGIN
  788.     ASSEMBLER
  789.         LINK    A5, #0
  790.         MOVEM.L D3/A4-A5,-(A7)
  791.         MOVE.W  -(A3), D3
  792.         
  793.         MOVE.L  -(A3),-(A7)
  794.         MOVE.L  A3,A1
  795.         MOVE.L  -(A1),-(A7)
  796.         MOVE.L  -(A1),-(A7)
  797.         MOVE.L  -(A1),-(A7)
  798.         CMPI.W  #11,-2   (A3)
  799.         BCC     ok1
  800.         TRAP    #noErrorTrap
  801.         DC.W    StringOverflow
  802.         MOVE.W  #11,-2   (A3)
  803. ok1
  804.         CMPI.W  #31,-8(A3)
  805.         BCC     ok2
  806.         TRAP    #noErrorTrap
  807.         DC.W    StringOverflow
  808.         MOVE.W  #31,-8(A3)
  809. ok2
  810.         JSR     stringIntoCFormat   ; ADR(name) -> D2
  811.         MOVE.L  pubs,A0
  812.         MOVE.L  D2,pubArrays.ADDRIN+4(A0)
  813.         MOVE.L  D2,A4               ; ADR(path) -> A4
  814.         JSR     stringIntoCFormat   ; ADR(path) -> D2
  815.         MOVE.L  pubs,A0
  816.         MOVE.L  D2,pubArrays.ADDRIN(A0)
  817.         MOVE.L  D2,A5               ; ADR(path) -> A5
  818.         MOVE.W  D3,(A3)+
  819.         JSR     aes_if
  820.         
  821.         MOVE.L  (A7),A0
  822.         MOVE.L  (A0),A0
  823.         MOVE.L  (A0)+,A1
  824.         MOVE.W  (A0)+,D0
  825. loop1
  826.         MOVE.B  (A5)+,(A1)+
  827.         DBF     D0,loop1
  828.         MOVE.L  (A0)+,A1
  829.         MOVE.W  (A0)+,D0
  830. loop2
  831.         MOVE.B  (A4)+,(A1)+
  832.         DBF     D0,loop2
  833.         MOVE.L  (A7),A7             ; Strings wieder vom Stack löschen
  834.         MOVE.L  (A7),A7
  835.         ADDA.W  #12,A7
  836.         
  837.         MOVE.L  pubs,A0
  838.         MOVE.L  (A7)+,A1
  839.         MOVE.W  pubArrays.aINTOUT+2(A0),(A1)
  840.         JSR     testINTOUT0
  841.         
  842.         MOVEM.L (A7)+,D3/A4-A5
  843.         UNLK    A5
  844.     END;
  845.   END selectFile0;
  846.  
  847. PROCEDURE selectFile (VAR path, name: ARRAY OF CHAR; VAR ok: BOOLEAN);
  848.  
  849.   BEGIN
  850.     ASSEMBLER
  851.         MOVE.W  #FSEL_INPUT,(A3)+
  852.         JMP     selectFile0
  853.     END;
  854.   END selectFile;
  855.  
  856. PROCEDURE selectFileExtended (REF label     : ARRAY OF CHAR;
  857.                               VAR path, name: ARRAY OF CHAR;
  858.                               VAR ok        : BOOLEAN);
  859.  
  860.   BEGIN
  861.     ASSEMBLER
  862.         MOVE.L  -22(A3), (A3)+
  863.         MOVE.W  -22(A3), (A3)+          ;  don't forget the 4 byte of the prev.
  864.         JSR     stringIntoCFormat
  865.         MOVE.L  pubs, A0
  866.         MOVE.L  D2, pubArrays.ADDRIN+8(A0)     ; 'label' an AES
  867.         
  868.         MOVE.W  #FSEL_EX_INPUT,(A3)+
  869.         JSR     selectFile0
  870.         
  871.         MOVE.L  (A7), A7
  872.         SUBQ.L  #6, A3
  873.     END;
  874.   END selectFileExtended;
  875.  
  876. PROCEDURE shellRead (VAR cmd, tail: ARRAY OF CHAR);
  877.  
  878.   BEGIN
  879.     ASSEMBLER
  880.         LINK    A5,#0
  881.         SUBA.W  #$200,A7
  882.         MOVE.L  pubs,A0
  883.         MOVE.L  A7,pubArrays.ADDRIN+4(A0)
  884.         LEA     $100(A7),A1
  885.         MOVE.L  A1,pubArrays.ADDRIN(A0)
  886.         MOVE.W  #SHEL_READ,(A3)+
  887.         CMPA.L  A3,A7
  888.         BLS     ovrflow
  889.         JSR     aes_if
  890.         JSR     testINTOUT0
  891.         LEA     -12(A3),A2
  892.  
  893.         ; TAIL kopieren
  894.         MOVE.L  A7,A0
  895.         MOVE    -(A3),D1
  896.         MOVE.L  -(A3),A1
  897.         MOVE.B  (A0)+,D2        ; Länge von TAIL
  898.       lup2:
  899.         SUBQ.B  #1,D2
  900.         BCS     endtail
  901.         MOVE.B  (A0)+,(A1)+
  902.         DBRA    D1,lup2
  903.         BSR     strovr
  904.         BRA     tocmd
  905.       endtail:
  906.         CLR.B   (A1)+
  907.  
  908.       tocmd:
  909.         ; CMD kopieren
  910.         LEA     $100(A7),A0
  911.         MOVE    -(A3),D1
  912.         MOVE.L  -(A3),A1
  913.       lup:
  914.         MOVE.B  (A0)+,(A1)+
  915.         DBEQ    D1,lup
  916.         BEQ     bye
  917.         BSR     strovr
  918.       bye:
  919.  
  920.         MOVE.L  A2,A3
  921.         UNLK    A5
  922.         RTS
  923.       strovr
  924.         TRAP    #noErrorTrap
  925.         DC.W    StringOverflow
  926.         RTS
  927.       ovrflow:
  928.         ADDA.W  #$200,A7
  929.         SUBA.W  #14,A3
  930.         TRAP    #noErrorTrap
  931.         DC.W    OutOfStack
  932.         UNLK    A5
  933.     END;
  934.   END shellRead;
  935.  
  936.  
  937.  
  938.                 (*  Von mehreren GEM Moduln benutzte GEM-Calls  *)
  939.                 (*  ==========================================  *)
  940.                 
  941. PROCEDURE grafMouse(form:WORD(* ~ AESGraphics.MouseForm*);
  942.                     mFormDefPtr:PtrMouseFormDef);
  943.                     
  944.                     
  945. (* !!!!!!!!! Muß 'AESGraphics.MouseForm' entsprechen !!!!!!!!!! *)
  946.  
  947. TYPE    MouseForm       = (arrow, textCursor, bee, pointHand, flatHand,
  948.                            thinCross, thickCross, outlineCross, userCursor,
  949.                            mouseOff, mouseOn);
  950.        
  951.   BEGIN
  952.     ASSEMBLER
  953.         MOVE.L  pubs,A0
  954.         MOVE.L  our_cb, A1
  955.         MOVE.L  -(A3),pubArrays.ADDRIN(A0)
  956.         MOVE.W  -(A3),D0
  957.         CMP.W   #mouseOff,D0
  958.         BNE     cont2
  959.         
  960.         ADDQ.W  #1,cb.SUPERVISION.noGrafMouse(A1)
  961.         BRA     noSuper
  962. cont2
  963.         CMP.W   #mouseOn,D0
  964.         BNE     noSuper
  965.         SUBQ.W  #1,cb.SUPERVISION.noGrafMouse(A1)
  966.         BPL     noSuper
  967.         CLR.W   cb.SUPERVISION.noGrafMouse(A1)
  968.         (*$? doSupervision:
  969.         BRA     ende
  970.         *)
  971. noSuper
  972.         CMP.W   #userCursor,D0
  973.         BLT     cont
  974.         ADD.W   #$FF,D0
  975.         SUB.W   #userCursor,D0
  976. cont
  977.         MOVE.L  pubs, A0
  978.         MOVE.W  D0,pubArrays.aINTIN(A0)
  979.         MOVE.W  #GRAF_MOUSE,(A3)+
  980.         JSR     aes_if
  981.         JSR     testINTOUT0
  982. ende
  983.     END;
  984.   END grafMouse;
  985.  
  986. PROCEDURE showCursor (handle:p_device; force:BOOLEAN);
  987.  
  988.   BEGIN
  989.     ASSEMBLER
  990.         MOVE.L  -6(A3),(A3)+
  991.         SUBQ.L  #2,A7
  992.         MOVE.L  A7,(A3)+
  993.         JSR     setDevice
  994.         TST.W   (A7)+
  995.         BNE     devOk
  996.         SUBQ.L  #6,A3
  997.         BRA     ende
  998.  
  999. devOk
  1000.         MOVE.L  our_cb,A0
  1001.         MOVE.W  -(A3),D0
  1002.         MOVE.L  cb.CURDEVICE(A0),A1
  1003.         TST.W   D0
  1004.         BNE     forceShow
  1005.         SUBQ.W  #1,device.noHdCurs(A1)
  1006.         BPL     noSuper
  1007.         CLR.W   device.noHdCurs(A1)
  1008.         BRA     ende
  1009. forceShow
  1010.         CLR.W   device.noHdCurs(A1)
  1011. noSuper
  1012.  
  1013.         EORI.W  #1,D0
  1014.         MOVE.L  pubs, A0
  1015.         MOVE.W  D0,pubArrays.vINTIN(A0)
  1016.         MOVE.W  #SHOW_CURSOR,(A3)+
  1017.         CLR.W   (A3)+
  1018.         JSR     vdi_if
  1019. ende
  1020.     END;
  1021.   END showCursor;
  1022.  
  1023. PROCEDURE hideCursor (device:p_device);
  1024.  
  1025.   BEGIN
  1026.     ASSEMBLER
  1027.         MOVE.L  -4(A3),(A3)+
  1028.         SUBQ.L  #2,A7
  1029.         MOVE.L  A7,(A3)+
  1030.         JSR     setDevice
  1031.         TST.W   (A7)+
  1032.         BNE     devOk
  1033.         SUBQ.L  #4,A3
  1034.         BRA     ende
  1035.  
  1036. devOk
  1037.         MOVE.L  our_cb,A0
  1038.         MOVE.L  cb.CURDEVICE(A0),A1
  1039.         ADDQ.W  #1,device.noHdCurs(A1)
  1040.  
  1041.         MOVE.W  #HIDE_CURSOR,(A3)+
  1042.         CLR.W   (A3)+
  1043.         JSR     vdi_if
  1044. ende
  1045.     END;
  1046.   END hideCursor;
  1047.  
  1048.  
  1049. PROCEDURE unloadFonts(handle:p_device;select:WORD);
  1050.  
  1051. BEGIN
  1052.   ASSEMBLER
  1053.         MOVE.L  pubs,A0
  1054.         MOVE.W  -(A3),pubArrays.vINTIN(A0)
  1055.         MOVE.L  -4(A3), (A3)+           ; !MS 'handle' retten
  1056.  
  1057.         SUBQ.L  #2,A7
  1058.         MOVE.L  A7,(A3)+
  1059.         JSR     setDevice
  1060.         TST.W   (A7)+
  1061.         BNE     ok
  1062.         SUBQ.L  #4,A3                     ; !MS 'handle' wegwerfen
  1063.         BRA     ende
  1064. ok      MOVE.W  #UNLOAD_FONTS,(A3)+       ; !MS hier steht 'handle' auf A3-Stk.
  1065.         CLR.W   (A3)+
  1066.         JSR     vdi_if
  1067.  
  1068.         MOVE.L  our_cb,A0
  1069.         MOVE.L  cb.CURDEVICE(A0),A1
  1070.         CLR     device.fontsLoaded(A1)
  1071. ende
  1072.   END;
  1073. END unloadFonts;
  1074.  
  1075.  
  1076. PROCEDURE updateWindow (update:WORD);
  1077.  
  1078.   BEGIN
  1079.     ASSEMBLER
  1080.         MOVE.L  our_cb,A0
  1081.         MOVE.W  -(A3),D0
  1082.         
  1083.         BTST    #0,D0
  1084.         BNE     addOne
  1085.         MOVEQ   #-1,D1
  1086.         BRA     cont
  1087. addOne
  1088.         MOVEQ   #1,D1
  1089. cont
  1090.         BTST    #1,D0
  1091.         BNE     mCtrl
  1092.         ADD.W   D1,cb.SUPERVISION.noUpWind(A0)
  1093.         BPL     noSuper
  1094.         CLR.W   cb.SUPERVISION.noUpWind(A0)
  1095.         (*$? doSupervision:
  1096.         BRA     ende
  1097.         *)
  1098. mCtrl
  1099.         ADD.W   D1,cb.SUPERVISION.noMouseCtrl(A0)
  1100.         BPL     noSuper
  1101.         CLR.W   cb.SUPERVISION.noMouseCtrl(A0)
  1102.         (*$? doSupervision:
  1103.         BRA     ende
  1104.         *)
  1105. noSuper
  1106.     
  1107.         MOVE.L  pubs, A0
  1108.         MOVE.W  D0,pubArrays.aINTIN(A0)
  1109.         MOVE.W  #WIND_UPDATE,(A3)+
  1110.         JSR     aes_if
  1111.         JSR     testINTOUT0
  1112. ende
  1113.     END;
  1114.   END updateWindow;
  1115.  
  1116. PROCEDURE closeWindow(handle:CARDINAL);
  1117.  
  1118.   BEGIN
  1119.     ASSEMBLER
  1120.         MOVE.L  our_cb,A0
  1121.         MOVE.W  -(A3),D0
  1122.         
  1123.         CMP.W   #31,D0
  1124.         BHI     noSuper                 ; springe, falls 'handle' zu groß
  1125.         MOVE.L  cb.SUPERVISION.openWinds(A0),D1
  1126.         BCLR    D0,D1                   ; delete handle out of OpenWind-list
  1127.         MOVE.L  D1,cb.SUPERVISION.openWinds(A0)
  1128. noSuper
  1129.  
  1130.         MOVE.L  pubs, A0
  1131.         MOVE.W  D0,pubArrays.aINTIN(A0)
  1132.         MOVE.W  #WIND_CLOSE,(A3)+
  1133.         JSR     aes_if
  1134.         JSR     testINTOUT0
  1135.     END;
  1136.   END closeWindow;
  1137.  
  1138. PROCEDURE deleteWindow(handle:CARDINAL);
  1139.  
  1140.   BEGIN
  1141.     ASSEMBLER
  1142.         MOVE.L  our_cb,A0
  1143.         MOVE.W  -(A3),D0
  1144.         
  1145.         CMP.W   #31,D0
  1146.         BHI     noSuper                 ; springe, falls 'handle' zu groß
  1147.         MOVE.L  cb.SUPERVISION.createWinds(A0),D1
  1148.         BCLR    D0,D1                   ; delete handle out of CreateWind-list
  1149.         MOVE.L  D1,cb.SUPERVISION.createWinds(A0)
  1150. noSuper
  1151.  
  1152.         MOVE.L  pubs, A0
  1153.         MOVE.W  D0,pubArrays.aINTIN(A0)
  1154.         MOVE.W  #WIND_DELETE,(A3)+
  1155.         JSR     aes_if
  1156.         JSR     testINTOUT0
  1157.     END;
  1158.   END deleteWindow;
  1159.  
  1160.  
  1161.                 (* IR-Vector routines (must be global for supervision) *)
  1162.  
  1163. PROCEDURE exchangeTimerVec(new:PROC;VAR time:CARDINAL):PROC;
  1164.  
  1165.   BEGIN
  1166.     ASSEMBLER
  1167.         MOVE.L  -(A3),-(A7)     ; VAR-Zeiger retten
  1168.         MOVE.L  our_cb,A0
  1169.         MOVE.L  -(A3),cb.V_CONTRL.multi1(A0)
  1170.         MOVE.L  cb.CURDEVICE(A0),(A3)+
  1171.         MOVE.W  #EX_TIMER_INTER,(A3)+
  1172.         CLR.W   (A3)+
  1173.         JSR     vdi_if
  1174.         MOVE.L  pubs,A0
  1175.         MOVE.L  (A7)+,A1
  1176.         MOVE.W  pubArrays.vINTOUT(A0),(A1)
  1177.         MOVE.L  our_cb,A0
  1178.         MOVE.L  cb.V_CONTRL.multi3(A0),(A3)+
  1179.     END;
  1180.   END exchangeTimerVec;
  1181.  
  1182. PROCEDURE exchangeMouseVec (opcode:CARDINAL;new:PROC) :PROC;
  1183.  
  1184.   BEGIN
  1185.     ASSEMBLER
  1186.         MOVE.L  our_cb,A0
  1187.         MOVE.L  -(A3),cb.V_CONTRL.multi1(A0)
  1188.         MOVE.W  -(A3),D0
  1189.         MOVE.L  cb.CURDEVICE(A0),(A3)+
  1190.         MOVE.W  D0,(A3)+
  1191.         CLR.W   (A3)+
  1192.         JSR     vdi_if
  1193.         MOVE.L  our_cb,A0
  1194.         MOVE.L  cb.V_CONTRL.multi3(A0),(A3)+
  1195.     END;
  1196.   END exchangeMouseVec;
  1197.  
  1198. PROCEDURE removeTimerVector(VAR hdl:vecListElem);
  1199.  
  1200.   BEGIN
  1201.     ASSEMBLER
  1202.         MOVE.L  -(A3),A1
  1203.         LEA     timerVecList,A0         ; ADR(TimerVecList) -> A0
  1204. loop
  1205.         MOVE.L  (A0),A2                 ; Ptr. to cur. 'vecListElem' -> A2
  1206.         CMPA.L  #NIL,A2
  1207.         BEQ     ready                   ; jump, if NIL
  1208.         CMPA.L  A1,A2
  1209.         BNE     noMatch                 ; jump, if element not found
  1210.         MOVE.L  vecListElem.next(A2),(A0) ; ausketten
  1211.         MOVE.L  timerVecList,D0
  1212.         BNE     ready                   ; springe, falls 'TimerVecList#NIL'
  1213.         MOVE.L  orgTimerVec,(A3)+       ; Setze Vector wieder in Normalzustand
  1214.         SUBQ.L  #2,A7
  1215.         MOVE.L  A7,(A3)+
  1216.         JSR     exchangeTimerVec        ; exchangeTimerVec(orgTimerVec,<VoidC>)
  1217.         ADDQ.L  #2,A7
  1218.         SUBQ.L  #4,A3                   ; Ergebnis ist irrelevant
  1219.         BRA     ready                   ; fertig!
  1220. noMatch
  1221.         LEA     vecListElem.next(A2),A0 ; ADR(vecListElem.next) -> A0
  1222.         BRA     loop
  1223. ready
  1224.         MOVE.L  our_cb,A0
  1225.         LEA     cb.SUPERVISION(A0),A0
  1226.         MOVE.L  timerVecList,D0
  1227.         CMP.L   superData.timerPrev(A0),D0
  1228.         BNE     cont                    ; bra, if vec's of this level remain
  1229.         CLR.W   superData.timerChgd(A0) ; Set flag to 'no timervec'
  1230. cont
  1231.     END;
  1232.   END removeTimerVector;
  1233.  
  1234. PROCEDURE removeButChgVector(VAR hdl:vecListElem);
  1235.  
  1236.   BEGIN
  1237.     ASSEMBLER
  1238.         MOVE.L  -(A3),A1
  1239.         LEA     butChgVecList,A0        ; ADR(ButChgVecList) -> A0
  1240. loop
  1241.         MOVE.L  (A0),A2                 ; Ptr. to cur. 'vecListElem' -> A2
  1242.         CMPA.L  #NIL,A2
  1243.         BEQ     ready                   ; jump, if NIL
  1244.         CMPA.L  A1,A2
  1245.         BNE     noMatch                 ; jump, if element not found
  1246.         MOVE.L  vecListElem.next(A2),(A0) ; ausketten
  1247.         MOVE.L  butChgVecList,D0
  1248.         BNE     ready                   ; springe, falls 'ButChgVecList#NIL'
  1249.         MOVE.W  #EX_BUT_CHANGE,(A3)+    ; Setze Vector wieder in Normalzustand
  1250.         MOVE.L  orgButChgVec,(A3)+      ; exchangeMouseVec(EX_BUT_CHANGE,
  1251.         JSR     exchangeMouseVec        ;                  orgButChgVec,deltaT)
  1252.         TST.L   -(A3)                   ; Ergebnis ist irrelevant
  1253.         BRA     ready                   ; fertig!
  1254. noMatch
  1255.         LEA     vecListElem.next(A2),A0 ; ADR(vecListElem.next) -> A0
  1256.         BRA     loop
  1257. ready
  1258.         MOVE.L  our_cb,A0
  1259.         LEA     cb.SUPERVISION(A0),A0
  1260.         MOVE.L  butChgVecList,D0
  1261.         CMP.L   superData.butChgPrev(A0),D0
  1262.         BNE     cont                    ; bra, if vec's of this level remain
  1263.         CLR.W   superData.butChgChgd(A0); Set flag to 'no butChgvec'
  1264. cont
  1265.     END;
  1266.   END removeButChgVector;
  1267.  
  1268. PROCEDURE removeMsMoveVector(VAR hdl:vecListElem);
  1269.  
  1270.   BEGIN
  1271.     ASSEMBLER
  1272.         MOVE.L  -(A3),A1
  1273.         LEA     msMoveVecList,A0        ; ADR(msMoveVecList) -> A0
  1274. loop
  1275.         MOVE.L  (A0),A2                 ; Ptr. to cur. 'vecListElem' -> A2
  1276.         CMPA.L  #NIL,A2
  1277.         BEQ     ready                   ; jump, if NIL
  1278.         CMPA.L  A1,A2
  1279.         BNE     noMatch                 ; jump, if element not found
  1280.         MOVE.L  vecListElem.next(A2),(A0) ; ausketten
  1281.         MOVE.L  msMoveVecList,D0
  1282.         BNE     ready                   ; springe, falls 'msMoveVecList#NIL'
  1283.         MOVE.W  #EX_MOUSE_MOVE,(A3)+    ; Setze Vector wieder in Normalzustand
  1284.         MOVE.L  orgMsMoveVec,(A3)+      ; exchangeMouseVec(EX_MOUSE_MOVE,
  1285.         JSR     exchangeMouseVec        ;                  orgMsMoveVec,deltaT)
  1286.         TST.L   -(A3)                   ; Ergebnis ist irrelevant
  1287.         BRA     ready                   ; fertig!
  1288. noMatch
  1289.         LEA     vecListElem.next(A2),A0 ; ADR(vecListElem.next) -> A0
  1290.         BRA     loop
  1291. ready
  1292.         MOVE.L  our_cb,A0
  1293.         LEA     cb.SUPERVISION(A0),A0
  1294.         MOVE.L  msMoveVecList,D0
  1295.         CMP.L   superData.msMovePrev(A0),D0
  1296.         BNE     cont                    ; bra, if vec's of this level remain
  1297.         CLR.W   superData.msMoveChgd(A0); Set flag to 'no msMovevec'
  1298. cont
  1299.     END;
  1300.   END removeMsMoveVector;
  1301.  
  1302. PROCEDURE removeCurChgVector(VAR hdl:vecListElem);
  1303.  
  1304.   BEGIN
  1305.     ASSEMBLER
  1306.         MOVE.L  -(A3),A1
  1307.         LEA     curChgVecList,A0        ; ADR(curChgVecList) -> A0
  1308. loop
  1309.         MOVE.L  (A0),A2                 ; Ptr. to cur. 'vecListElem' -> A2
  1310.         CMPA.L  #NIL,A2
  1311.         BEQ     ready                   ; jump, if NIL
  1312.         CMPA.L  A1,A2
  1313.         BNE     noMatch                 ; jump, if element not found
  1314.         MOVE.L  vecListElem.next(A2),(A0) ; ausketten
  1315.         MOVE.L  curChgVecList,D0
  1316.         BNE     ready                   ; springe, falls 'curChgVecList#NIL'
  1317.         MOVE.W  #EX_MOUSE_CHANGE,(A3)+    ; Setze Vector wieder in Normalzustand
  1318.         MOVE.L  orgCurChgVec,(A3)+      ; exchangeMouseVec(EX_MOUSE_CHANGE,
  1319.         JSR     exchangeMouseVec        ;                  orgCurChgVec,deltaT)
  1320.         TST.L   -(A3)                   ; Ergebnis ist irrelevant
  1321.         BRA     ready                   ; fertig!
  1322. noMatch
  1323.         LEA     vecListElem.next(A2),A0 ; ADR(vecListElem.next) -> A0
  1324.         BRA     loop
  1325. ready
  1326.         MOVE.L  our_cb,A0
  1327.         LEA     cb.SUPERVISION(A0),A0
  1328.         MOVE.L  curChgVecList,D0
  1329.         CMP.L   superData.curChgPrev(A0),D0
  1330.         BNE     cont                    ; bra, if vec's of this level remain
  1331.         CLR.W   superData.curChgChgd(A0); Set flag to 'no curChgvec'
  1332. cont
  1333.     END;
  1334.   END removeCurChgVector;
  1335.  
  1336. BEGIN
  1337.  
  1338.   (*  Liste initalisieren
  1339.    *)
  1340.   root_cb := NIL;
  1341.   our_cb := root_cb;
  1342.   
  1343.   pubs := NIL;
  1344.   
  1345.   error := FALSE;         (*  Kein Fehler aufgetretten  *)
  1346.   errorProcPtr := NIL;    (*  Keine Fehlerroutine angemeldet  *)
  1347.   ptrToErrHdler := NIL;
  1348.   
  1349.                 (*  'Plugs' zurücksetzen  *)
  1350.   
  1351.   keyboardPlugActive := FALSE;
  1352.   buttonPlugActive := FALSE;
  1353.   firstRectPlugActive := FALSE;
  1354.   secondRectPlugActive := FALSE;
  1355.   messagePlugActive := FALSE;
  1356.   timerPlugActive := FALSE;
  1357.   
  1358. END GEMShare.
  1359.